home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Except / HVExceptNotify.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-09-06  |  2.8 KB  |  88 lines
  1. unit HVExceptNotify;
  2. // Unit that provides a notification service when exceptions are being raised
  3. //
  4. // Written by Hallvard Vassbotn, hallvard@balder.no, September 1999
  5. interface
  6.  
  7. type
  8.   TExceptNotify = procedure (ExceptObj: TObject; ExceptAddr: pointer; OSException: boolean);
  9. var
  10.   ExceptNotify: TExceptNotify;
  11.  
  12. implementation
  13.  
  14. uses
  15.   Windows,
  16.   SysUtils,
  17.   HVHookDLL;
  18.  
  19. var
  20.   Kernel32_RaiseException : procedure (dwExceptionCode, dwExceptionFlags, nNumberOfArguments: DWORD;
  21.   lpArguments: PDWORD); stdcall;
  22.  
  23. type
  24.   PExceptionArguments = ^TExceptionArguments;
  25.   TExceptionArguments = record
  26.     ExceptAddr: pointer;
  27.     ExceptObj : TObject;
  28.   end;
  29.  
  30. procedure HookedRaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments: DWORD;
  31.   Arguments: PExceptionArguments); stdcall;
  32. // All calls to Kernel32.RaiseException ends up here
  33. const
  34.   // D2 has a different signature for Delphi exceptions
  35.   cDelphiException    = {$IFDEF VER90}$0EEDFACE{$ELSE}$0EEDFADE{$ENDIF};
  36.   cNonContinuable     = 1;
  37. begin
  38.   // We're only interested in Delphi exceptions raised from System's
  39.   // internal _RaiseExcept routine
  40.   if (ExceptionFlags    = cNonContinuable)       and
  41.      (ExceptionCode     = cDelphiException)      and
  42.      (NumberOfArguments = 7)                     and
  43.      (DWORD(Arguments)  = DWORD(@Arguments) + 4) then
  44.   begin
  45.     // Run the event if it has been assigned
  46.     if Assigned(ExceptNotify) then
  47.       ExceptNotify(Arguments.ExceptObj, Arguments.ExceptAddr, false);
  48.   end;
  49.   // Call the original routine in Kernel32.DLL
  50.   Kernel32_RaiseException(ExceptionCode, ExceptionFlags, NumberOfArguments, PDWORD(Arguments));
  51. end;
  52.  
  53. var
  54.   SysUtils_ExceptObjProc: function (P: PExceptionRecord): Exception;
  55.  
  56. function HookedExceptObjProc(P: PExceptionRecord): Exception;
  57. begin
  58.   // Non-Delphi exceptions such as AVs, OS and hardware exceptions
  59.   // end up here. This routine is normally resposible for creating
  60.   // a Delphi Exception object corresponding to the OS-level exception
  61.   // described in the TExceptionRecord structure.
  62.   //
  63.   // We leave the mapping to the standard SysUtils routine,
  64.   // but hook this to know about the exception and call our
  65.   // event.
  66.  
  67.   // First call the original mapping function in SysUtils
  68.   Result := SysUtils_ExceptObjProc(P);
  69.  
  70.   // Run the event if it has been assigned
  71.   if Assigned(ExceptNotify) then
  72.     ExceptNotify(Result, P^.ExceptionAddress, true);
  73. end;
  74.  
  75. initialization
  76.   SysUtils_ExceptObjProc := System.ExceptObjProc;
  77.   System.ExceptObjProc := @HookedExceptObjProc;
  78.   HookImport('Kernel32.dll', 'RaiseException', @HookedRaiseException, @Kernel32_RaiseException)
  79.  
  80. finalization
  81.   UnHookImport('Kernel32.dll', 'RaiseException', @HookedRaiseException, @Kernel32_RaiseException);
  82.   System.ExceptObjProc := @SysUtils_ExceptObjProc;
  83.   SysUtils_ExceptObjProc := nil;
  84.  
  85. end.
  86.  
  87.  
  88.